#' @importFrom dplyr %>% left_join
#' @importFrom stats setNames
#' @noRd
tidy_link_data <- function(df,
                           cor_tbl,
                           spec.key = "spec",
                           env.key = "env",
                           env.point.hjust = NULL,
                           env.point.vjust = NULL,
                           spec.point.hjust = NULL,
                           spec.point.vjust = NULL,
                           on.left = FALSE,
                           diag.label = FALSE)
{
  if(!is_cor_tbl(cor_tbl))
    stop("Need a cor_tbl.", call. = FALSE)
  col.names <- get_col_name(cor_tbl)
  row.names <- rev(get_row_name(cor_tbl))
  type <- get_type(cor_tbl)
  show.diag <- get_show_diag(cor_tbl)
  spec.name <- unique(df[[spec.key]])
  env_data <- link_env_data(row.names = row.names,
                            n.row = length(row.names),
                            n.col = length(col.names),
                            type = type,
                            show.diag = show.diag,
                            hjust = env.point.hjust,
                            vjust = env.point.vjust,
                            on.left = on.left,
                            diag.label = diag.label)
  spec_data <- link_spec_data(spec.name = spec.name,
                               n.row = length(row.names),
                               n.col = length(col.names),
                               type = type,
                               hjust = spec.point.hjust,
                               vjust = spec.point.vjust,
                               on.left = on.left)
  link_data <- df %>%
    dplyr::left_join(env_data, by = setNames("env.key", env.key)) %>%
    dplyr::left_join(spec_data, by = setNames("spec.key", spec.key))
  structure(.Data = link_data, class = c("link_tbl", class(link_data)))
}

#' @importFrom tibble tibble
#' @noRd
link_spec_data <- function(spec.name,
                           n.row,
                           n.col,
                           type,
                           hjust = NULL,
                           vjust = NULL,
                           on.left = FALSE)
{
  len <- length(spec.name)
  if(!is.null(hjust) && length(hjust) != len)
    hjust <- rep_len(hjust, len)
  if(!is.null(vjust) && length(hjust) != len)
    vjust <- rep_len(vjust, len)
  if(type == "full") {
    y <- seq(0.5, n.row + 0.5, length.out = len + 2)[2:(len + 1)]
    if(on.left) {
      x <- rep_len(0.5 - 0.40 * n.col, len)
    } else {
      x <- rep_len(n.col + 0.5 + 0.40 * n.col, len)
    }
  } else if(type == "upper") {
    if(len == 1) {
      x <- 0.5 + 0.18 * n.col
      y <- 0.5 + 0.3 * n.row
    } else if(len == 2) {
      x <- c(0.5 - 0.02 * n.col, 0.5 + 0.2 * n.col)
      y <- c(0.5 + 0.46 * n.row, 0.5 + 0.2 * n.row)
    } else {
      y0 <- 0.5 + n.row * (1 - 0.3)
      y1 <- 0.5 + n.row * 0.1
      x0 <- 0.5 - 0.25 * n.col
      x1 <- 0.5 + 0.3 * n.col
      y <- seq(y0, y1, length.out = len)
      x <- seq(x0, x1, length.out = len)
    }
  } else {
    if(len == 1) {
      x <- 0.5 + 0.82 * n.col
      y <- 0.5 + 0.7 * n.row
    } else if(len == 2) {
      x <- c(0.5 + 0.8 * n.col, 0.5 + 1.02 * n.col)
      y <- c(0.5 + 0.8 * n.row, 0.5 + 0.54 * n.row)
    } else {
      y0 <- 0.5 + n.row * (1 - 0.1)
      y1 <- 0.5 + n.row * 0.3
      x0 <- 0.5 + 0.75 * n.col
      x1 <- 0.5 + 1.3 * n.col
      y <- seq(y0, y1, length.out = len)
      x <- seq(x0, x1, length.out = len)
    }
  }
  if(!is.null(hjust))
    x <- x + hjust
  if(!is.null(vjust))
    y <- y + vjust
  new_data_frame(list(link.x = x,
                      link.y = y,
                      spec.key = spec.name))
}
#' @importFrom tibble tibble
#' @noRd
link_env_data <- function(row.names,
                          n.row,
                          n.col,
                          type = "upper",
                          show.diag = FALSE,
                          hjust = NULL,
                          vjust = NULL,
                          on.left = FALSE,
                          diag.label = FALSE)
{
  if(!is.null(hjust) && length(hjust) != n.row)
    hjust <- rep_len(hjust, n.row)
  if(!is.null(vjust) && length(hjust) != n.row)
    vjust <- rep_len(vjust, n.row)
  x <- n.col:1
  y <- 1:n.row
  if(type == "full") {
    if(on.left) {
      x <- rep_len(0, n.row)
    } else {
      x <- rep_len(n.col + 1, n.row)
    }
  } else {
    if(type == "upper") {
      if(show.diag) {
        if(diag.label) {
          x <- x - 2
        } else {
          x <- x - 1
        }
      } else {
        if(diag.label) {
          x <- x - 1
        }
      }
    } else {
      if(show.diag) {
        if(diag.label) {
          x <- x + 2
        } else {
          x <- x + 1
        }
      } else {
        if(diag.label) {
          x <- x + 1
        }
      }
    }
  }
  if(!is.null(hjust))
    x <- x + hjust
  if(!is.null(vjust))
    y <- y + vjust
  new_data_frame(list(link.xend = x,
                      link.yend = y,
                      env.key = row.names))
}
